home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / autodesk.arc / LTEXT.LSP < prev    next >
Encoding:
Text File  |  1987-04-24  |  8.4 KB  |  315 lines
  1. ;************************* READTEXT.LSP *****************************
  2.  
  3. ;   Adapted from LTEXT.LSP
  4. ;       By Simon Jones  Autodesk Ltd, London  4 July 1986
  5.  
  6. ;       Modified for use with AutoCAD 2.6     23 April 1987
  7.  
  8. ;   Use LTEXT.LSP to insert ASCII text files into AutoCAD drawings.
  9. ;   The blocks of text can either Left, Centre, Middle or Right
  10. ;   Justified.
  11.  
  12. ;   The file name must include an extension and may include a
  13. ;   directory prefix, as in /acad/sample.txt or \\acad\\sample.txt.
  14.  
  15. ;   Apart from height (unless fixed) & rotational angle,
  16. ;   "Text options" include:
  17. ;       Define distance between lines.
  18. ;       Define opening line for reading.
  19. ;       Define number of lines to read.
  20. ;       Global under/overscoring of lines.
  21. ;       Global upper/lower case change.
  22. ;    &  Column definitions.
  23.  
  24. ;********************************************************************
  25.  
  26. ;--------:GLOBAL variables
  27.  
  28. ; a$$    :Last angle (for default value)
  29. ; f$$    :Last file  (for default value)
  30. ; rtfile :Read File
  31. ; ang    :Rotation angle
  32. ; c      :Total line count
  33. ; cd     :Column distance
  34. ; d      :Distance between lines
  35. ; eof    :End of file flag
  36. ; l1     :First line to read
  37. ; h      :Text height
  38. ; j      :Text justification
  39. ; lc     :Column line count
  40. ; n      :Number of lines to read
  41. ; nl     :Number of lines per column
  42. ; opt    :Options list
  43. ; pt     :Text insertion point
  44. ; pt1    :First text insertion point
  45. ; rf     :File to read
  46. ; s      :Text string
  47. ; ts     :Text style list
  48. ; ul     :Upper/lower case flag
  49.  
  50. (defun MODES (a)
  51.    (setq MLST '())
  52.    (repeat (length a)
  53.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  54.       (setq a (cdr a)))
  55. )
  56.  
  57. (defun MODER ()
  58.    (repeat (length MLST)
  59.       (setvar (caar MLST) (cadar MLST))
  60.       (setq MLST (cdr MLST))
  61.    )
  62. )
  63.  
  64.  
  65. (defun *ERROR* (st)
  66.   (moder)
  67.   (if (= (type rtfile) 'FILE) (close rtfile))
  68.   (setq rtfile nil)
  69.   (terpri)
  70.   (princ "\nerror: ")
  71.   (princ st)
  72.   (princ)
  73. )
  74.  
  75.  
  76.    ;Function for inserting text a recalculation of insertion
  77.    ;point.
  78.  
  79.    (defun 1LTXT ()
  80.       (if (member '1 opt) (setq s (strcat "%%u" s "%%u")))
  81.       (if (member '2 opt) (setq s (strcat "%%o" s "%%o")))
  82.       (if (member '4 opt) (setq s (strcase s)))
  83.       (if (member '8 opt) (setq s (strcase s T)))
  84.       (if (and (= lc (1+ nl)) (/= nl 0))
  85.           (progn
  86.            (setq lc 1)
  87.            (setq pt (polar pt1 ang cd))
  88.            (setq pt1 pt)
  89.           )
  90.       )
  91.       (cond ((and (= j "L") h)
  92.              (command "TEXT" pt h (rtd ang) s)
  93.             )
  94.             ((and (/= j "L") h)
  95.              (command "TEXT" j pt h (rtd ang) s)
  96.             )
  97.             ((and (= j "L") (null h))
  98.              (command "TEXT" pt (rtd ang) s)
  99.             )
  100.             ((and (/= j "L") (null h))
  101.              (command "TEXT" j pt (rtd ang) s)
  102.             )
  103.       )
  104.       (if (/= d "Auto")
  105.           (if (= (cdr (assoc 70 ts)) 4)
  106.               (setq pt (polar pt (+ (dtr 90) ang) d))
  107.               (setq pt (polar pt (+ (dtr 270) ang) d))
  108.           )
  109.       )
  110.       (setq c (1+ c))
  111.       (if (= c n)
  112.           (setq eof T)
  113.       )
  114.    )
  115.  
  116.    ;Degrees to radians conversion
  117.    (defun DTR (y)
  118.     (* pi (/ y 180.0))
  119.    )
  120.    ;Radians to degrees conversion
  121.    (defun RTD (Y)
  122.     (* 180.0 (/ y pi))
  123.    )
  124.  
  125. ;********************** MAIN PROGRAM ***************************
  126.  
  127.  
  128. (defun C:LTEXT (/ ang c cd d eof rtfile rf h
  129.                   j l1 opt pt pt1 ts n nl lc s ul)
  130.  
  131.   ; a$$ holds default ANGLE
  132.   ; f$$ holds default fILE
  133.  
  134.   (modes '("BLIPMODE" "CMDECHO" "HIGHLIGHT"))
  135.  
  136.   (while (null rtfile)
  137.          ;Prompt for file to be inserted
  138.          (if (null f$$)
  139.              (progn
  140.               (initget 1)
  141.               (prompt "\nFile to read (including extension): ")
  142.              )
  143.              (progn
  144.               (prompt "\nFile to read (including extension)/<")
  145.               (princ (strcat f$$ ">: "))
  146.              )
  147.          )
  148.          (setq rf (getstring))
  149.          (if (= rf "")
  150.              (setq rf f$$)
  151.          )
  152.          (setq rtfile (open rf "r"))
  153.          (if rtfile
  154.              (setq f$$ rf)
  155.              (prompt "\nFile not found. ")
  156.          )
  157.   )
  158.  
  159.   ;Prompt for start point or justification
  160.   (initget 1  "Centre Middle Right")
  161.   (setq pt (getpoint
  162.              "\nStart point or Centre/Middle/Right: "
  163.            )
  164.   )
  165.   (if (/= (type pt) 'LIST)
  166.       (setq j (substr pt 1 1))
  167.       (setq j "L")
  168.   )
  169.  
  170.  
  171.   ;Prompt for an insertion point
  172.   (if (/= (type pt) 'LIST)
  173.       (progn
  174.        (initget 1)
  175.        (setq pt (getpoint (strcat "\n" pt " point: ")))
  176.       )
  177.   )
  178.   (setq pt1 pt)  ; First insertion point
  179.  
  180.   ;Prompt for a text height
  181.   (setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE"))
  182.         h nil
  183.   )
  184.   (if (= (cdr (assoc 40 ts)) 0.0)
  185.       (progn
  186.         (setq h (getdist pt (strcat "\nHeight <"
  187.                                     (rtos (getvar "TEXTSIZE"))
  188.                                     ">: "
  189.                             )
  190.                 )
  191.         )
  192.         (if (null h) (setq h (getvar "TEXTSIZE")))
  193.       )
  194.   )
  195.  
  196.   ;Prompt for rotational angle of text
  197.   (if (null a$$)
  198.       (progn
  199.        (if (= (cdr (assoc 70 ts)) 4)  ; Vertical style text
  200.            (progn
  201.             (setq a$$ 270)
  202.             (prompt "\nRotational angle <270>: ")
  203.            )
  204.            (progn
  205.             (setq a$$ 0)
  206.             (prompt "\nRotational angle <0>: ")
  207.            )
  208.        )
  209.       )
  210.       (progn
  211.        (prompt "\nRotational angle <")
  212.        (princ (strcat (angtos a$$) ">: "))
  213.       )
  214.   )
  215.   (setq ang (getangle pt))
  216.   (if (null ang) (setq ang a$$))
  217.   (setq a$$ ang)
  218.  
  219.   (setq d "Auto" l1 1 n "All" opt nil lc 0 nl 0 c 0)
  220.  
  221.   (initget "Yes No")
  222.   (if (= "Yes"  (getkword "\nChange text options? <No>: "))
  223.      (progn
  224.  
  225.        ;Prompt for distance between lines.
  226.        (initget "Auto")
  227.        (setq d (getdist pt "\nDistance between lines/<Auto>: "))
  228.        (if (= d nil) (setq d "Auto"))
  229.  
  230.        ;Prompt for first line to read.
  231.        (initget (+ 2 4))
  232.        (setq l1 (getint "\nFirst line to read/<1>: "))
  233.        (if (null l1) (setq l1 1))
  234.  
  235.        ;Prompt for number of following lines.
  236.        (initget (+ 2 4) "All")
  237.        (setq n (getint "\nNumber of lines to read/<All>: "))
  238.        (if (= n "All") (setq n nil))
  239.  
  240.        (initget "Yes No")
  241.        (if (= "Yes" (getkword "\nUnderscore each line <No>: "))
  242.            (setq opt (append opt '(1)))
  243.        )
  244.        (initget "Yes No")
  245.        (if (= "Yes" (getkword "\nOverscore each line <No>: "))
  246.            (setq opt (append opt '(2)))
  247.        )
  248.  
  249.        ; Option for global redefinition of text case.
  250.        (initget "Upper Lower No")
  251.        (prompt "\nChange text case? ")
  252.        (setq ul (getkword "  Upper/Lower/<No>: "))
  253.        (cond ((= ul "Upper") (setq opt (append opt '(4))))
  254.              ((= ul "Lower") (setq opt (append opt '(8))))
  255.        )
  256.  
  257.        ; Option for setting up columns.
  258.        (initget "Yes No")
  259.        (if (= "Yes" (getkword "\nSet up columns? <No>: "))
  260.            (progn
  261.             (setq opt (append opt '(16)))
  262.             (initget (+ 1 2))
  263.             (setq cd (getdist pt "\nDistance between columns: "))
  264.             (initget (+ 1 2 4))
  265.             (setq nl (getint "\nNumber of lines per column: "))
  266.            )
  267.        )
  268.  
  269.      )
  270.   )
  271.   (setvar "BLIPMODE" 0)
  272.   (setvar "HIGHLIGHT" 0)
  273.   (setvar "CMDECHO" 0)
  274.  
  275.   (setq eof nil)
  276.   (setq s (repeat l1 (read-line rtfile)))
  277.  
  278.   (setq lc (1+ lc))
  279.   (1ltxt)
  280.   (while (null eof)
  281.     (if (= d "Auto")
  282.         (progn
  283.          (setq s (read-line rtfile))
  284.          (setq lc (1+ lc))
  285.          (if s
  286.            (progn
  287.             (if (= lc (1+ nl))
  288.                 (1ltxt)
  289.                 (progn
  290.                  (if (member '1 opt) (setq s (strcat "%%u" s "%%u")))
  291.                  (if (member '2 opt) (setq s (strcat "%%o" s "%%o")))
  292.                  (if (member '4 opt) (setq s (strcase s)))
  293.                  (if (member '8 opt) (setq s (strcase s T)))
  294.                  (command "TEXT" "" s)
  295.                  (setq c (1+ c))
  296.                  (if (= c n) (setq eof T))
  297.                 )
  298.             )
  299.            )
  300.            (setq eof T)
  301.          )
  302.         )
  303.         (progn
  304.          (setq s (read-line rtfile))
  305.          (setq lc (1+ lc))
  306.          (if s (1ltxt) (setq eof T))
  307.         )
  308.     )
  309.   )
  310.   (close rtfile)
  311.   (setq rtfile nil)
  312.   (moder)
  313.   (princ)
  314. )
  315.